home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Hacks / Hacks ’94 / [√] Distribution Restricted! / Christian Ruse / Fourier Paper + Apps / nih-image154_source.sea / V1.54 Source / Math.p < prev    next >
Text File  |  1994-01-27  |  25KB  |  1,000 lines

  1. unit Math;
  2.  
  3. interface
  4.  
  5.     uses
  6.  
  7.         QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, Camera, Filters;
  8.  
  9.  
  10.     procedure SetPasteMode (item: integer);
  11.     procedure DoMouseDownInPasteControl (loc: point);
  12.     procedure ShowPasteControl;
  13.     procedure DrawPasteControl;
  14.     procedure DoArithmetic (MenuItem: integer; constant: extended);
  15.     procedure DoMath (Src1PicNum, Src2PicNum: integer; result: str255);
  16.     procedure DoPasteMath;
  17.     procedure DoImageMath;
  18.  
  19.  
  20. implementation
  21.  
  22.     const
  23.         Src1Item = 7;
  24.         Src2Item = 8;
  25.         OpItem = 9;
  26.  
  27.  
  28.     procedure DoPasteMath;
  29.         const
  30.             PixelsPerUpdate = 15000;
  31.         var
  32.             nrows, ncols, hSrcStart, vSrcStart, hDstStart, vDstStart: integer;
  33.             SaveInfo: InfoPtr;
  34.             h, v, vDst, PixelCount, offset: integer;
  35.             Src, Dst: LineType;
  36.             tmp, range, min, max, StartTicks: LongInt;
  37.             x, xmax, xmin, xrange, xscale: extended;
  38.     begin
  39.         if TooWide then
  40.             exit(DoPasteMath);
  41.         ShowWatch;
  42.         OpPending := false;
  43.         WhatToUndo := UndoPaste;
  44.         KillRoi;
  45.         with info^.RoiRect do begin
  46.                 ncols := right - left;
  47.                 nrows := bottom - top;
  48.                 hDstStart := left;
  49.                 vDstStart := top;
  50.             end;
  51.         with ClipBufInfo^.RoiRect do begin
  52.                 hSrcStart := left;
  53.                 vSrcStart := top;
  54.             end;
  55.         if hDstStart < 0 then begin
  56.                 offset := -hDstStart;
  57.                 hDstStart := 0;
  58.                 hSrcStart := hSrcStart + offset;
  59.                 ncols := ncols - offset;
  60.             end;
  61.         if vDstStart < 0 then begin
  62.                 offset := -vDstStart;
  63.                 vDstStart := 0;
  64.                 vSrcStart := vSrcStart + offset;
  65.                 nrows := nrows - offset;
  66.             end;
  67.         with info^.PicRect do begin
  68.                 if hDstStart + ncols > right then
  69.                     ncols := right - hDstStart;
  70.                 if vDstStart + nrows > bottom then
  71.                     nrows := bottom - vDstStart;
  72.             end;
  73.         SaveInfo := info;
  74.         vDst := vDstStart;
  75.         min := 999999;
  76.         max := -999999;
  77.         xmin := 999999.0;
  78.         xmax := -999999.0;
  79.         StartTicks := TickCount;
  80.        {First pass to find result range}
  81.         if ScaleArithmetic then begin
  82.                 for v := vSrcStart to vSrcStart + nRows - 1 do begin
  83.                         Info := ClipBufInfo;
  84.                         GetLine(hSrcStart, v, nCols, Src);
  85.                         Info := SaveInfo;
  86.                         GetLine(hDstStart, vDst, nCols, Dst);
  87.                         case CurrentOp of
  88.                             AddOp:  begin
  89.                                     for h := 0 to nCols - 1 do begin
  90.                                             tmp := Src[h] + Dst[h];
  91.                                             if tmp > max then
  92.                                                 max := tmp;
  93.                                             if tmp < Min then
  94.                                                 min := tmp;
  95.                                         end;
  96.                                 end;
  97.                             SubtractOp:  begin
  98.                                     for h := 0 to nCols - 1 do begin
  99.                                             tmp := Dst[h] - Src[h];
  100.                                             if tmp > max then
  101.                                                 max := tmp;
  102.                                             if tmp < Min then
  103.                                                 min := tmp;
  104.                                         end;
  105.                                 end;
  106.                             MultiplyOp:  begin
  107.                                     for h := 0 to nCols - 1 do begin
  108.                                             tmp := LongInt(Dst[h]) * Src[h];
  109.                                             if tmp > max then
  110.                                                 max := tmp;
  111.                                             if tmp < min then
  112.                                                 min := tmp;
  113.                                         end;
  114.                                 end;
  115.                             DivideOp:  begin
  116.                                     for h := 0 to nCols - 1 do begin
  117.                                             tmp := Src[h];
  118.                                             if tmp = 0 then
  119.                                                 tmp := 1;
  120.                                             x := Dst[h] / tmp;
  121.                                             if x > xmax then begin
  122.                                                     xmax := x;
  123.                                                 end;
  124.                                             if x < xmin then
  125.                                                 xmin := x;
  126.                                         end;
  127.                                 end;
  128.                         end;
  129.                         vDst := vDst + 1;
  130.                     end;
  131.                 vDst := vDstStart;
  132.                 if CurrentOp = DivideOp then begin
  133.                         xrange := xmax - xmin;
  134.                         if xrange <> 0.0 then
  135.                             xscale := 256.0 / xrange
  136.                         else
  137.                             xscale := 1;
  138.                     end
  139.                 else
  140.                     range := max - min;
  141.             end; {if ScaleArithmetic=true}
  142.         PixelCount := 0;
  143.        {Second pass to do arithmetic and scaling}
  144.         for v := vSrcStart to vSrcStart + nRows - 1 do begin
  145.                 Info := ClipBufInfo;
  146.                 GetLine(hSrcStart, v, nCols, Src);
  147.                 Info := SaveInfo;
  148.                 GetLine(hDstStart, vDst, nCols, Dst);
  149.                 case CurrentOp of
  150.                     AddOp: 
  151.                         if ScaleArithmetic then
  152.                             for h := 0 to nCols - 1 do begin
  153.                                     tmp := Dst[h] + Src[h] - min;
  154.                                     if range <> 0 then
  155.                                         tmp := tmp * 256 div range
  156.                                     else
  157.                                         tmp := BackgroundIndex;
  158.                                     if tmp > 255 then
  159.                                         dst[h] := 255
  160.                                     else
  161.                                         dst[h] := tmp;
  162.                                 end
  163.                         else
  164.                             for h := 0 to nCols - 1 do begin
  165.                                     tmp := Dst[h] + Src[h];
  166.                                     if tmp > 255 then
  167.                                         dst[h] := 255
  168.                                     else
  169.                                         dst[h] := tmp;
  170.                                 end;
  171.                     SubtractOp: 
  172.                         if ScaleArithmetic then
  173.                             for h := 0 to nCols - 1 do begin
  174.                                     tmp := Dst[h] - Src[h] - min;
  175.                                     if range <> 0 then
  176.                                         tmp := tmp * 256 div range
  177.                                     else
  178.                                         tmp := BackgroundIndex;
  179.                                     if tmp > 255 then
  180.                                         dst[h] := 255
  181.                                     else
  182.                                         dst[h] := tmp;
  183.                                 end
  184.                         else
  185.                             for h := 0 to nCols - 1 do begin
  186.                                     tmp := Dst[h] - Src[h];
  187.                                     if tmp < 0 then
  188.                                         dst[h] := 0
  189.                                     else
  190.                                         dst[h] := tmp;
  191.                                 end;
  192.                     MultiplyOp: 
  193.                         if ScaleArithmetic then
  194.                             for h := 0 to nCols - 1 do begin
  195.                                     tmp := LongInt(Dst[h]) * Src[h] - min;
  196.                                     if range <> 0 then
  197.                                         tmp := tmp * 256 div range
  198.                                     else
  199.                                         tmp := BackgroundIndex;
  200.                                     if tmp > 255 then
  201.                                         dst[h] := 255
  202.                                     else
  203.                                         dst[h] := tmp;
  204.                                 end
  205.                         else
  206.                             for h := 0 to nCols - 1 do begin
  207.                                     tmp := LongInt(Dst[h]) * Src[h];
  208.                                     if tmp > 255 then
  209.                                         dst[h] := 255
  210.                                     else
  211.                                         dst[h] := tmp;
  212.                                 end;
  213.                     DivideOp: 
  214.                         if ScaleArithmetic then
  215.                             for h := 0 to nCols - 1 do begin
  216.                                     tmp := Src[h];
  217.                                     if tmp = 0 then
  218.                                         tmp := 1;
  219.                                     x := Dst[h] / tmp - xmin;
  220.                                     if xrange <> 0.0 then
  221.                                         tmp := trunc(x * xscale)
  222.                                     else
  223.                                         tmp := BackgroundIndex;
  224.                                     if tmp > 255 then
  225.                                         tmp := 255;
  226.                                     if tmp < 0 then
  227.                                         tmp := 0;
  228.                                     dst[h] := tmp;
  229.                                 end
  230.                         else
  231.                             for h := 0 to nCols - 1 do begin
  232.                                     tmp := Src[h];
  233.                                     if tmp = 0 then
  234.                                         tmp := 1;
  235.                                     dst[h] := Dst[h] div tmp;
  236.                                 end;
  237.                 end;
  238.                 PutLine(hDstStart, vDst, nCols, Dst);
  239.                 vDst := vDst + 1;
  240.                 PixelCount := PixelCount + ncols;
  241.                 if PixelCount > PixelsPerUpdate then begin
  242.                         UpdateScreen(info^.RoiRect);
  243.                         if CommandPeriod then begin
  244.                                 UpdateScreen(info^.RoiRect);
  245.                                 beep;
  246.                                 exit(DoPasteMath)
  247.                             end;
  248.                         PixelCount := 0;
  249.                     end;
  250.             end;
  251.         with info^ do begin
  252.                 ShowTime(StartTicks, RoiRect, '');
  253.                 UpdateScreen(RoiRect);
  254.             end;
  255.     end;
  256.  
  257.  
  258.     procedure SetPasteMode (item: integer);
  259.         var
  260.             SavePort: GrafPtr;
  261.             BlendColor: rgbColor;
  262.     begin
  263.         if not macro then begin
  264.                 SetForegroundColor(BlackIndex);
  265.                 SetBackGroundColor(WhiteIndex);
  266.             end;
  267.         case Item of
  268.             CopyModeItem: 
  269.                 PasteTransferMode := SrcCopy;
  270.             AndItem: 
  271.                 PasteTransferMode := NotSrcBic; {And}
  272.             OrItem: 
  273.                 PasteTransferMode := SrcOr;
  274.             XorItem: 
  275.                 PasteTransferMode := SrcXor;
  276.             ReplaceItem: 
  277.                 PasteTransferMode := Transparent;
  278.             BlendItem:  begin
  279.                     GetPort(SavePort);
  280.                     with BlendColor do begin
  281.                             red := 32767;
  282.                             blue := 32767;
  283.                             green := 32767;
  284.                         end;
  285.                     SetPort(GrafPtr(info^.osPort));
  286.                     OpColor(BlendColor);
  287.                     SetPort(SavePort);
  288.                     PasteTransferMode := Blend;
  289.                 end;
  290.             otherwise
  291.         end; {case}
  292.     end;
  293.  
  294.  
  295.     function GetTransferModeItem: integer;
  296.     begin
  297.         case PasteTransferMode of
  298.             SrcCopy: 
  299.                 GetTransferModeItem := CopyModeItem;
  300.             NotSrcBic: 
  301.                 GetTransferModeItem := AndItem;
  302.             SrcOr: 
  303.                 GetTransferModeItem := OrItem;
  304.             SrcXor: 
  305.                 GetTransferModeItem := XorItem;
  306.             Transparent: 
  307.                 GetTransferModeItem := ReplaceItem;
  308.             Blend: 
  309.                 GetTransferModeItem := BlendItem;
  310.         end;
  311.     end;
  312.  
  313.  
  314.     procedure DrawPasteControl;
  315.         const
  316.             bWidth = 64;
  317.             bHeight = 14;
  318.             vinc = 18;
  319.             bhloc = 114;
  320.             bvloc = 6;
  321.         var
  322.             tPort: GrafPtr;
  323.             i, hloc, vloc, item: integer;
  324.             tType: pcItemType;
  325.             tRect, TriangleRect: rect;
  326.             ItemStr: str255;
  327.     begin
  328.         GetPort(tPort);
  329.         SetPort(PasteControl);
  330.         with PcItem[1] do begin
  331.                 SetRect(r, 15, 22, 95, 40);
  332.                 itype := pcPopupMenu;
  333.                 str := 'Transfer Mode';
  334.             end;
  335.         with pcItem[2] do begin
  336.                 SetRect(r, 88, 50, 100, 62);
  337.                 itype := pcCheckBox;
  338.                 str := 'Scale Math';
  339.             end;
  340.         with pcItem[3] do begin
  341.                 SetRect(r, 88, 65, 100, 77);
  342.                 itype := pcCheckBox;
  343.                 str := 'Live Paste';
  344.             end;
  345.         hloc := bhloc;
  346.         vloc := bvloc;
  347.         tType := pcButton;
  348.         with pcItem[4] do begin
  349.                 SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
  350.                 itype := tType;
  351.                 str := 'Add';
  352.             end;
  353.         vloc := vloc + vinc;
  354.         with pcItem[5] do begin
  355.                 SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
  356.                 itype := tType;
  357.                 str := 'Subtract';
  358.             end;
  359.         vloc := vloc + vinc;
  360.         with pcItem[6] do begin
  361.                 SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
  362.                 itype := tType;
  363.                 str := 'Multiply';
  364.             end;
  365.         vloc := vloc + vinc;
  366.         with pcItem[7] do begin
  367.                 SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
  368.                 itype := tType;
  369.                 str := 'Divide';
  370.             end;
  371.         TextFont(SystemFont);
  372.         TextSize(12);
  373.         for i := 1 to npcItems do
  374.             with pcItem[i] do
  375.                 case iType of
  376.                     pcPopupMenu: 
  377.                         with r do begin
  378.                                 MoveTo(r.left - 10, r.top - 4);
  379.                                 DrawString(str);
  380.                                 DrawDropBox(r);
  381.                                 item := GetTransferModeItem;
  382.                                 GetItem(TransferModeMenuH, item, ItemStr);
  383.                                 MoveTo(left + 13, bottom - 5);
  384.                                 DrawString(ItemStr);
  385.                             end;
  386.                     pcCheckBox: 
  387.                         with r do begin
  388.                                 MoveTo(left - StringWidth(str) - 4, bottom - 2);
  389.                                 DrawString(str);
  390.                                 EraseRect(r);
  391.                                 FrameRect(r);
  392.                                 if ((i = 2) and ScaleArithmetic) or ((i = 3) and LivePasteMode) then begin
  393.                                         MoveTo(left, top);
  394.                                         LineTo(right - 1, bottom - 1);
  395.                                         MoveTo(left, bottom - 1);
  396.                                         LineTo(right - 1, top);
  397.                                     end;
  398.                             end;
  399.                     pcButton:  begin
  400.                             FrameRoundRect(r, 6, 6);
  401.                             with r do
  402.                                 MoveTo(left + ((right - left) - StringWidth(str)) div 2, bottom - 3);
  403.                             DrawString(str);
  404.                         end;
  405.                 end; {case}
  406.         SetPort(tPort);
  407.     end;
  408.  
  409.  
  410.     procedure DoMouseDownInPasteControl; {(loc:point)}
  411.         var
  412.             nItem, i, MenuItem: integer;
  413.             tr: rect;
  414.     begin
  415.         if not (OpPending and (CurrentOp = PasteOp)) then begin
  416.                 PutMessage('Paste Control is only available during paste operations.');
  417.                 exit(DoMouseDownInPasteControl);
  418.             end;
  419.         SetPort(PasteControl);
  420.         GlobalToLocal(loc);
  421.         nItem := 0;
  422.         for i := 1 to npcItems do
  423.             if PtInRect(loc, pcItem[i].r) then
  424.                 nitem := i;
  425.         if nItem > 0 then begin
  426.                 case pcItem[nItem].itype of
  427.                     pcPopUpMenu: 
  428.                         with pcItem[1].r do begin
  429.                                 MenuItem := PopUpMenu(TransferModeMenuH, left, top, GetTransferModeItem);
  430.                                 SetPasteMode(MenuItem);
  431.                             end;
  432.                     pcCheckBox:  begin
  433.                             tr := pcItem[nItem].r;
  434.                             InsetRect(tr, 1, 1);
  435.                             FrameRect(tr);
  436.                             if nitem = 2 then
  437.                                 ScaleArithmetic := not ScaleArithmetic;
  438.                             if nitem = 3 then begin
  439.                                     LivePasteMode := not LivePasteMode;
  440.                                     if LivePasteMode then begin
  441.                                             ExternalTrigger := false;
  442.                                             UpdateVideoControl
  443.                                         end;
  444.                                 end;
  445.                         end;
  446.                     pcButton:  begin
  447.                             InvertRoundRect(pcItem[nitem].r, 6, 6);
  448.                             while Button and (nitem > 0) do begin
  449.                                     GetMouse(loc);
  450.                                     if not PtInRect(loc, pcItem[nitem].r) then begin
  451.                                             InvertRoundRect(pcItem[nitem].r, 6, 6);
  452.                                             nItem := 0;
  453.                                         end;
  454.                                 end;
  455.                         end;
  456.                 end; {case}
  457.                 repeat
  458.                 until not button;
  459.                 if nItem > 0 then
  460.                     with pcItem[nitem] do begin
  461.                             case itype of
  462.                                 pcPopupMenu: 
  463.                                     ;
  464.                                 pcCheckBox:  begin
  465.                                     end;
  466.                                 pcButton:  begin
  467.                                         InvertRoundRect(pcItem[nitem].r, 6, 6);
  468.                                         if info^.RoiType = RectRoi then begin
  469.                                                 case nitem of
  470.                                                     4: 
  471.                                                         CurrentOp := AddOp;
  472.                                                     5: 
  473.                                                         CurrentOp := SubtractOp;
  474.                                                     6: 
  475.                                                         CurrentOp := MultiplyOp;
  476.                                                     7: 
  477.                                                         CurrentOp := DivideOp;
  478.                                                 end;
  479.                                                 DoPasteMath;
  480.                                             end; {if}
  481.                                     end; {pcButton}
  482.                             end; {case}
  483.                         end; {with}
  484.             end; {if nitem>0}
  485.         if LivePasteMode and ((WhatsOnClip <> CameraPic) or ((FrameGrabber <> QuickCapture) and (FrameGrabber <> ScionLG3))) then begin
  486.                 PutMessage('"Live Paste" requires that a rectangular selection be first copied from the Camera window to the Clipboard.');
  487.                 LivePasteMode := false;
  488.             end;
  489.         if LivePasteMode and (info^.PictureType = FrameGrabberType) then begin
  490.                 PutMessage('Live pasting into the Camera window is not supported.');
  491.                 LivePasteMode := false;
  492.             end;
  493.         DrawPasteControl;
  494.     end;
  495.  
  496.  
  497.     procedure ShowPasteControl;
  498.         var
  499.             tPort: GrafPtr;
  500.             trect: rect;
  501.             wp: ^WindowPtr;
  502.     begin
  503.         SetRect(trect, PasteControlLeft, PasteControlTop, PasteControlLeft + pcwidth, PasteControlTop + pcheight);
  504.         PasteControl := NewWindow(nil, trect, 'Paste Control', true, rDocProc, nil, true, 0);
  505.         WindowPeek(PasteControl)^.WindowKind := PasteControlKind;
  506.         wp := pointer(GhostWindow);
  507.         wp^ := PasteControl;
  508.         PasteTransferMode := SrcCopy;
  509.         LivePasteMode := false;
  510.     end;
  511.  
  512.  
  513.     procedure DoArithmetic (MenuItem: integer; constant: extended);
  514.         var
  515.             table: LookupTable;
  516.             i: integer;
  517.             tmp: LongInt;
  518.             LogScale: extended;
  519.             Canceled: boolean;
  520.     begin
  521.         canceled := false;
  522.         if not macro then
  523.             case menuItem of
  524.                 AddItem: 
  525.                     constant := GetReal('Constant to add:', 25, Canceled);
  526.                 SubtractItem: 
  527.                     constant := GetReal('Constant to subtract:', 25, Canceled);
  528.                 MultiplyItem:  begin
  529.                         constant := GetReal('Constant to multiply by:', 1.25, Canceled);
  530.                         if constant < 0.0 then begin
  531.                                 PutMessage('Constant must be positive.');
  532.                                 exit(DoArithmetic);
  533.                             end;
  534.                     end;
  535.                 DivideItem:  begin
  536.                         constant := GetReal('Constant to divide by:', 1.25, Canceled);
  537.                         if constant <= 0.0 then begin
  538.                                 PutMessage('Constant must be nonzero and positive.');
  539.                                 exit(DoArithmetic);
  540.                             end;
  541.                     end;
  542.                 LogItem:  begin
  543.                         constant := 0.0;
  544.                         LogScale := 255.0 / ln(255.0);
  545.                     end;
  546.             end; {case}
  547.         if Canceled then
  548.             exit(DoArithmetic);
  549.         for i := 0 to 255 do begin
  550.                 case MenuItem of
  551.                     AddItem: 
  552.                         tmp := round(i + constant);
  553.                     SubtractItem: 
  554.                         tmp := round(i - constant);
  555.                     MultiplyItem: 
  556.                         tmp := round(i * constant);
  557.                     DivideItem: 
  558.                         tmp := round(i / constant);
  559.                     LogItem: 
  560.                         if i = 0 then
  561.                             tmp := 0
  562.                         else
  563.                             tmp := round(ln(i) * LogScale);
  564.                 end;
  565.                 if tmp < 0 then
  566.                     tmp := 0;
  567.                 if tmp > 255 then
  568.                     tmp := 255;
  569.                 table[i] := tmp;
  570.             end;
  571.         ApplyTable(table);
  572.     end;
  573.  
  574.  
  575.     function GetInfoPtr (PicN: integer): InfoPtr;
  576.   {Converts a pic number or pid number to an Info ptr.}
  577.         var
  578.             i: integer;
  579.     begin
  580.         i := 0;
  581.         while (PicN < 0) and (i < nPics) do begin
  582.                 i := i + 1;
  583.                 if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
  584.                     PicN := i;
  585.             end;
  586.         if (PicN >= 1) or (PicN <= nPics) then
  587.             GetInfoPtr := pointer(WindowPeek(PicWindow[PicN])^.RefCon)
  588.         else
  589.             GetInfoPtr := nil;
  590.     end;
  591.  
  592.  
  593.     procedure DoMath (Src1PicNum, Src2PicNum: integer; result: str255);
  594.         const
  595.             PixelsPerUpdate = 5000;
  596.         var
  597.             nrows, ncols, hStart, vStart: integer;
  598.             Src1Info, Src2Info, SaveInfo: InfoPtr;
  599.             h, v, PixelCount: integer;
  600.             src1, src2, dst: LineType;
  601.             tmp, tmp1, tmp2, StartTicks, scale, ScaledGain: LongInt;
  602.             rtmp: real;
  603.             roi: rect;
  604.             DoScaling: boolean;
  605.     begin
  606.         if TooWide then
  607.             exit(DoMath);
  608.         Src1Info := GetInfoPtr(Src1PicNum);
  609.         Src2Info := GetInfoPtr(Src2PicNum);
  610.         if (Src1Info = nil) or (Src2Info = nil) then begin
  611.                 PutMessage('Bad pic num or pid num.');
  612.                 macro := false;
  613.                 exit(DoMath);
  614.             end;
  615.         ShowWatch;
  616.         if Src1Info^.RoiShowing and (Src1Info^.RoiType = RectRoi) then
  617.             roi := Src1Info^.RoiRect
  618.         else if Src2Info^.RoiShowing and (Src2Info^.RoiType = RectRoi) then
  619.             roi := Src2Info^.RoiRect
  620.         else
  621.             roi := Src1Info^.PicRect;
  622.         if not SectRect(roi, Src1Info^.PicRect, roi) then begin
  623.                 macro := false;
  624.                 exit(DoMath);
  625.             end;
  626.         if not SectRect(roi, Src2Info^.PicRect, roi) then begin
  627.                 macro := false;
  628.                 exit(DoMath);
  629.             end;
  630.         with roi do begin
  631.                 ncols := right - left;
  632.                 nrows := bottom - top;
  633.                 hStart := left;
  634.                 vStart := top;
  635.             end;
  636.         if (ncols < 30) or (nrows < 1) then begin
  637.                 PutMessage('Selection is too small.');
  638.                 macro := false;
  639.                 exit(DoMath);
  640.             end;
  641.         if not NewPicWindow(result, ncols, nrows) then
  642.             exit(DoMath);
  643.         SaveInfo := info;
  644.         StartTicks := TickCount;
  645.         PixelCount := 0;
  646.         scale := 10000;
  647.         ScaledGain := round(MathGain * scale);
  648.         DoScaling := (MathGain <> 1.0) or (MathOffset <> 0);
  649.         for v := vStart to vStart + nRows - 1 do begin
  650.                 info := Src1Info;
  651.                 GetLine(hStart, v, nCols, src1);
  652.                 Info := Src2Info;
  653.                 GetLine(hStart, v, nCols, src2);
  654.                 case CurrentMathOp of
  655.                     AddMath: 
  656.                         for h := 0 to nCols - 1 do begin
  657.                                 tmp := src1[h] + src2[h];
  658.                                 tmp := (tmp * ScaledGain) div scale + MathOffset;
  659.                                 if tmp > 255 then
  660.                                     tmp := 255;
  661.                                 if tmp < 0 then
  662.                                     tmp := 0;
  663.                                 dst[h] := tmp;
  664.                             end;
  665.                     SubMath: 
  666.                         for h := 0 to nCols - 1 do begin
  667.                                 tmp := src1[h] - src2[h];
  668.                                 tmp := (tmp * ScaledGain) div scale + MathOffset;
  669.                                 if tmp > 255 then
  670.                                     tmp := 255;
  671.                                 if tmp < 0 then
  672.                                     tmp := 0;
  673.                                 dst[h] := tmp;
  674.                             end;
  675.                     MulMath: 
  676.                         for h := 0 to nCols - 1 do begin
  677.                                 tmp := LongInt(src1[h]) * src2[h];
  678.                                 tmp := (tmp * ScaledGain) div scale + MathOffset;
  679.                                 if tmp > 255 then
  680.                                     tmp := 255;
  681.                                 if tmp < 0 then
  682.                                     tmp := 0;
  683.                                 dst[h] := tmp;
  684.                             end;
  685.                     DivMath: 
  686.                         for h := 0 to nCols - 1 do begin
  687.                                 rtmp := src1[h] / src2[h];
  688.                                 tmp := round(rtmp * MathGain) + MathOffset;
  689.                                 if tmp > 255 then
  690.                                     tmp := 255;
  691.                                 if tmp < 0 then
  692.                                     tmp := 0;
  693.                                 dst[h] := tmp;
  694.                             end;
  695.                     AndMath: 
  696.                         for h := 0 to nCols - 1 do begin
  697.                                 tmp := band(src1[h], src2[h]);
  698.                                 if DoScaling then begin
  699.                                         tmp := (tmp * ScaledGain) div scale + MathOffset;
  700.                                         if tmp > 255 then
  701.                                             tmp := 255;
  702.                                         if tmp < 0 then
  703.                                             tmp := 0;
  704.                                     end;
  705.                                 dst[h] := tmp;
  706.                             end;
  707.                     OrMath: 
  708.                         for h := 0 to nCols - 1 do begin
  709.                                 tmp := bor(src1[h], src2[h]);
  710.                                 if DoScaling then begin
  711.                                         tmp := (tmp * ScaledGain) div scale + MathOffset;
  712.                                         if tmp > 255 then
  713.                                             tmp := 255;
  714.                                         if tmp < 0 then
  715.                                             tmp := 0;
  716.                                     end;
  717.                                 dst[h] := tmp;
  718.                             end;
  719.                     XorMath: 
  720.                         for h := 0 to nCols - 1 do begin
  721.                                 tmp := bxor(src1[h], src2[h]);
  722.                                 if DoScaling then begin
  723.                                         tmp := (tmp * ScaledGain) div scale + MathOffset;
  724.                                         if tmp > 255 then
  725.                                             tmp := 255;
  726.                                         if tmp < 0 then
  727.                                             tmp := 0;
  728.                                     end;
  729.                                 dst[h] := tmp;
  730.                             end;
  731.                     MaxMath: 
  732.                         for h := 0 to nCols - 1 do begin
  733.                                 tmp1 := src1[h];
  734.                                 tmp2 := src2[h];
  735.                                 if tmp1 >= tmp2 then
  736.                                     tmp := tmp1
  737.                                 else
  738.                                     tmp := tmp2;
  739.                                 if DoScaling then begin
  740.                                         tmp := (tmp * ScaledGain) div scale + MathOffset;
  741.                                         if tmp > 255 then
  742.                                             tmp := 255;
  743.                                         if tmp < 0 then
  744.                                             tmp := 0;
  745.                                     end;
  746.                                 dst[h] := tmp;
  747.                             end;
  748.                     MinMath: 
  749.                         for h := 0 to nCols - 1 do begin
  750.                                 tmp1 := src1[h];
  751.                                 tmp2 := src2[h];
  752.                                 if tmp1 <= tmp2 then
  753.                                     tmp := tmp1
  754.                                 else
  755.                                     tmp := tmp2;
  756.                                 if DoScaling then begin
  757.                                         tmp := (tmp * ScaledGain) div scale + MathOffset;
  758.                                         if tmp > 255 then
  759.                                             tmp := 255;
  760.                                         if tmp < 0 then
  761.                                             tmp := 0;
  762.                                     end;
  763.                                 dst[h] := tmp;
  764.                             end;
  765.                     CopyMath: 
  766.                         for h := 0 to nCols - 1 do begin
  767.                                 tmp := src1[h];
  768.                                 if DoScaling then begin
  769.                                         tmp := (tmp * ScaledGain) div scale + MathOffset;
  770.                                         if tmp > 255 then
  771.                                             tmp := 255;
  772.                                         if tmp < 0 then
  773.                                             tmp := 0;
  774.                                     end;
  775.                                 dst[h] := tmp;
  776.                             end;
  777.                 end;
  778.                 Info := SaveInfo;
  779.                 PutLine(0, v - vstart, nCols, Dst);
  780.                 PixelCount := PixelCount + ncols;
  781.                 if PixelCount > PixelsPerUpdate then begin
  782.                         UpdateScreen(info^.RoiRect);
  783.                         if CommandPeriod then begin
  784.                                 UpdateScreen(info^.RoiRect);
  785.                                 beep;
  786.                                 macro := false;
  787.                                 exit(DoMath)
  788.                             end;
  789.                         PixelCount := 0;
  790.                     end;
  791.             end;
  792.         with info^ do begin
  793.                 ShowTime(StartTicks, RoiRect, '');
  794.                 UpdateScreen(RoiRect);
  795.                 Changes := true;
  796.             end;
  797.     end;
  798.  
  799.  
  800.     function ImageTitle (var PicNumber: integer): str255;
  801.         var
  802.             TempInfo: InfoPtr;
  803.     begin
  804.         if (PicNumber < 1) or (PicNumber > nPics) then
  805.             PicNumber := 1;
  806.         TempInfo := pointer(WindowPeek(PicWindow[PicNumber])^.RefCon);
  807.         ImageTitle := TempInfo^.title;
  808.     end;
  809.  
  810.  
  811.     procedure ImageMathUProc (d: DialogPtr; item: integer);
  812.      {User proc for Image Math dialog box}
  813.         var
  814.             str: str255;
  815.             VersInfo: str255;
  816.             r: rect;
  817.     begin
  818.         SetPort(d);
  819.         GetDItemRect(d, item, r);
  820.         DrawDropBox(r);
  821.         case item of
  822.             Src1Item: 
  823.                 DrawPopUpText(ImageTitle(MathSrc1), r);
  824.             Src2Item: 
  825.                 DrawPopUpText(ImageTitle(MathSrc2), r);
  826.             OpItem:  begin
  827.                     GetItem(ImageMathOpsMenuH, ord(CurrentMathOp) + 1, str);
  828.                     DrawPopUpText(str, r);
  829.                 end;
  830.         end;
  831.     end;
  832.  
  833.  
  834.     function PopUpImageList (r: rect; CurrentImage: integer): integer;
  835.         var
  836.             i: integer;
  837.     begin
  838.         for i := 1 to nPics do begin
  839.                 AppendMenu(ImageListMenuH, ' ');
  840.                 SetItem(ImageListMenuH, i, ImageTitle(i));
  841.             end;
  842.         PopUpImageList := PopUpMenu(ImageListMenuH, r.left, r.top, CurrentImage);
  843.         for i := 1 to nPics do
  844.             DelMenuItem(ImageListMenuH, 1);
  845.     end;
  846.  
  847.  
  848.     procedure DoImageMath;
  849.         const
  850.             ScaleItem = 10;
  851.             OffsetItem = 11;
  852.             ResultItem = 12;
  853.         var
  854.             d: DialogPtr;
  855.             item, i, MenuItem: integer;
  856.             r: rect;
  857.             str: str255;
  858.             ScaleOffEdited: boolean;
  859.  
  860.         procedure ShowScaleAndOffset;
  861.         begin
  862.             SetDReal(d, ScaleItem, MathGain, 4);
  863.             SetDNum(d, OffsetItem, MathOffset);
  864.         end;
  865.  
  866.         procedure ResetScaleOff;
  867.         begin
  868.             if not ScaleOffEdited then begin
  869.                     MathGain := 1.0;
  870.                     MathOffset := 0;
  871.                     ShowScaleAndOffset;
  872.                 end;
  873.         end;
  874.  
  875.     begin
  876.         InitCursor;
  877.         ScaleOffEdited := false;
  878.         d := GetNewDialog(200, nil, pointer(-1));
  879.         SetUProc(d, Src1Item, @ImageMathUProc);
  880.         SetUProc(d, Src2Item, @ImageMathUProc);
  881.         SetUProc(d, OpItem, @ImageMathUProc);
  882.         ShowScaleAndOffset;
  883.         SetDString(d, ResultItem, MathResult);
  884.         if (MathSrc1 = 1) and (MathSrc2 = 1) then
  885.             MathSrc1 := info^.PicNum;
  886.         if MathSrc1 = MathSrc2 then begin
  887.                 if MathSrc1 = info^.PicNum then begin
  888.                         MathSrc2 := MathSrc2 + 1;
  889.                         if MathSrc2 > nPics then
  890.                             MathSrc2 := 1;
  891.                     end
  892.                 else
  893.                     MathSrc2 := info^.PicNum;
  894.             end;
  895.         repeat
  896.             if item = Src1Item then begin
  897.                     setport(d);
  898.                     GetDItemRect(d, item, r);
  899.                     MenuItem := PopUpImageList(r, MathSrc1);
  900.                     DrawDropBox(r);
  901.                     if MenuItem <> 0 then
  902.                         MathSrc1 := MenuItem;
  903.                     DrawPopUpText(ImageTitle(MathSrc1), r);
  904.                 end;
  905.             if item = Src2Item then begin
  906.                     setport(d);
  907.                     GetDItemRect(d, item, r);
  908.                     MenuItem := PopUpImageList(r, MathSrc2);
  909.                     DrawDropBox(r);
  910.                     if MenuItem <> 0 then
  911.                         MathSrc2 := MenuItem;
  912.                     DrawPopUpText(ImageTitle(MathSrc2), r);
  913.                 end;
  914.             if item = OpItem then begin
  915.                     setport(d);
  916.                     GetDItemRect(d, item, r);
  917.                     MenuItem := PopUpMenu(ImageMathOpsMenuH, r.left, r.top, ord(CurrentMathOp) + 1);
  918.                     case MenuItem of
  919.                         1:  begin
  920.                                 CurrentMathOp := AddMath;
  921.                                 if not ScaleOffEdited then begin
  922.                                         MathGain := 0.5;
  923.                                         MathOffset := 0;
  924.                                         ShowScaleAndOffset;
  925.                                     end;
  926.                             end;
  927.                         2:  begin
  928.                                 CurrentMathOp := SubMath;
  929.                                 if not ScaleOffEdited then begin
  930.                                         MathGain := 0.5;
  931.                                         MathOffset := 128;
  932.                                         ShowScaleAndOffset;
  933.                                     end;
  934.                             end;
  935.                         3:  begin
  936.                                 CurrentMathOp := MulMath;
  937.                                 if not ScaleOffEdited then begin
  938.                                         MathGain := 1.0 / 255.0;
  939.                                         MathOffset := 0;
  940.                                         ShowScaleAndOffset;
  941.                                     end;
  942.                             end;
  943.                         4:  begin
  944.                                 CurrentMathOp := DivMath;
  945.                                 if not ScaleOffEdited then begin
  946.                                         MathGain := 255.0;
  947.                                         MathOffset := 0;
  948.                                         ShowScaleAndOffset;
  949.                                     end;
  950.                             end;
  951.                         5:  begin
  952.                                 CurrentMathOp := AndMath;
  953.                                 ResetScaleOff;
  954.                             end;
  955.                         6:  begin
  956.                                 CurrentMathOp := OrMath;
  957.                                 ResetScaleOff;
  958.                             end;
  959.                         7:  begin
  960.                                 CurrentMathOp := XorMath;
  961.                                 ResetScaleOff;
  962.                             end;
  963.                         8:  begin
  964.                                 CurrentMathOp := MaxMath;
  965.                                 ResetScaleOff;
  966.                             end;
  967.                         9:  begin
  968.                                 CurrentMathOp := MinMath;
  969.                                 ResetScaleOff;
  970.                             end;
  971.                         10:  begin
  972.                                 CurrentMathOp := CopyMath;
  973.                                 ResetScaleOff;
  974.                             end;
  975.                         otherwise
  976.                     end;
  977.                     DrawDropBox(r);
  978.                     GetItem(ImageMathOpsMenuH, ord(CurrentMathOp) + 1, str);
  979.                     DrawPopUpText(str, r);
  980.                 end;
  981.             if item = ScaleItem then begin
  982.                     MathGain := GetDReal(d, ScaleItem);
  983.                     ScaleOffEdited := true;
  984.                 end;
  985.             if item = OffsetItem then begin
  986.                     MathOffset := GetDNum(d, OffsetItem);
  987.                     ScaleOffEdited := true;
  988.                 end;
  989.             ModalDialog(nil, item);
  990.         until (item = ok) or (item = cancel);
  991.         MathResult := GetDString(d, ResultItem);
  992.         DisposDialog(d);
  993.         if item = cancel then
  994.             exit(DoImageMath);
  995.         DoMath(MathSrc1, MathSrc2, MathResult);
  996.     end;
  997.  
  998.  
  999.  
  1000. end.